home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbhelp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-16  |  6.3 KB  |  210 lines
  1. (*===========================================================================*)
  2. (* HELP command                                                              *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1990, 1991 by H. Roy Engehausen.  All rights      *)
  5. (*   reserved.                                                               *)
  6. (*                                                                           *)
  7. (*===========================================================================*)
  8.  
  9. {$O+}
  10.  
  11. {$UNDEF help_bug}
  12.  
  13. UNIT BBHELP;
  14.  
  15. INTERFACE
  16.  
  17. PROCEDURE help_cmd(cmd_string : STRING);
  18.  
  19. IMPLEMENTATION
  20.  
  21.   USES
  22.     CRT,
  23.     bbdummy,
  24.     bbmdata,
  25.     bbmess,
  26.     bbmisc,
  27.     bbmisc5,
  28.     bbsdata,
  29.     bbstr,
  30.     bbuf,
  31.     bbwin,
  32.     match;
  33.  
  34. (*===========================================================================*)
  35. (* HELP command                                                              *)
  36. (*===========================================================================*)
  37.  
  38. PROCEDURE help_cmd(cmd_string : STRING);
  39.  
  40.   VAR
  41.     found  : BOOLEAN;
  42.     help_f : TEXT;
  43.     i      : WORD;
  44.     t_str  : STRING;
  45.  
  46.   BEGIN;
  47.  
  48.     (*-----------------------------------------------------------------------*)
  49.     (* Remove blanks                                                         *)
  50.     (*-----------------------------------------------------------------------*)
  51.  
  52.     strip_crlf(cmd_string);
  53.  
  54.     (*-----------------------------------------------------------------------*)
  55.     (* Validate command                                                      *)
  56.     (*-----------------------------------------------------------------------*)
  57.  
  58.     IF (LENGTH(cmd_string) > 1) AND (cmd_string[2] <> ' ') THEN
  59.       BEGIN;
  60.         send_message(message_err_2nd);
  61.         active_tcb^.error_sw := TRUE;
  62.         EXIT;
  63.       END;
  64.  
  65.     IF words(cmd_string) > 2 THEN
  66.       BEGIN;
  67.         send_message(message_err_wrd);
  68.         active_tcb^.error_sw := TRUE;
  69.         EXIT;
  70.       END;
  71.  
  72.     (*-----------------------------------------------------------------------*)
  73.     (* Get the thing to look for                                             *)
  74.     (*-----------------------------------------------------------------------*)
  75.  
  76.     IF words(cmd_string) = 1 THEN
  77.       cmd_string := '_'
  78.     ELSE
  79.       cmd_string := subword(@cmd_string, 2, 1);
  80.  
  81.     (*-----------------------------------------------------------------------*)
  82.     (* Construct file name to use based on user's language                   *)
  83.     (*-----------------------------------------------------------------------*)
  84.  
  85.     t_str := opt_block.help_fn;
  86.  
  87.     i := POS(active_tcb^.uid_data.user_lang, opt_block.language_list);
  88.  
  89.     IF i = 0 THEN
  90.       i := POS(active_port^.dflt_lang, opt_block.language_list);
  91.  
  92.     IF i > 1 THEN
  93.       t_str := t_str + opt_block.language_list[i];
  94.  
  95.     (*-----------------------------------------------------------------------*)
  96.     (* Attempt to open the file                                              *)
  97.     (*-----------------------------------------------------------------------*)
  98.  
  99.     ASSIGN(help_f, t_str);
  100.  
  101.     {$I-}
  102.     RESET(help_f);
  103.     {$I+}
  104.  
  105.     i := IORESULT;
  106.  
  107.     (*-----------------------------------------------------------------------*)
  108.     (* If we couldn't open the help file and the language feature is in      *)
  109.     (* use then switch back to the master help file                          *)
  110.     (*-----------------------------------------------------------------------*)
  111.  
  112.     IF (i <> 0) AND (t_str <> opt_block.help_fn) THEN
  113.       BEGIN;
  114.  
  115.         ASSIGN(help_f, opt_block.help_fn);
  116.  
  117.         {$I-}
  118.         RESET(help_f);
  119.         {$I+}
  120.  
  121.         i := IORESULT;
  122.  
  123.       END;
  124.  
  125.     (*-----------------------------------------------------------------------*)
  126.     (* File won't open                                                       *)
  127.     (*-----------------------------------------------------------------------*)
  128.  
  129.     IF i <> 0 THEN
  130.       BEGIN;
  131.         send_tnc_data_str(dos_err_message(i));
  132.         active_tcb^.error_sw := TRUE;
  133.         EXIT;
  134.       END;
  135.  
  136.     (*-----------------------------------------------------------------------*)
  137.     (* Assume we haven't found anything yet                                  *)
  138.     (*-----------------------------------------------------------------------*)
  139.  
  140.     found := FALSE;
  141.  
  142.     upcase_str_var(cmd_string);
  143.  
  144.     {$IFDEF help_bug}
  145.       WRITELN('HELP=', LENGTH(cmd_string), '=', cmd_string);
  146.     {$ENDIF}
  147.  
  148.     WHILE (NOT found) AND (NOT EOF(help_f)) DO
  149.       BEGIN;
  150.         READLN(help_f, t_str);
  151.         IF t_str[1] = ':' THEN
  152.           BEGIN;
  153.  
  154.             {$IFDEF help_bug}
  155.               WRITELN('TSTR=', LENGTH(t_str), '=', t_str);
  156.               WRITELN('TSTR2=', LENGTH(SUBWORD(@t_str, 2, 1)) , '=',
  157.                                                        SUBWORD(@t_str, 2, 1));
  158.               WRITELN('TSTR3=', match_str(cmd_string, SUBWORD(@t_str, 2, 1)));
  159.               DELAY(1000);
  160.             {$ENDIF}
  161.  
  162.             IF words(t_str) <> 3 THEN
  163.               window_write_critical('HELP:> Bad help file line --', t_str)
  164.             ELSE
  165.               IF match_str(cmd_string, SUBWORD(@t_str, 2, 1)) THEN
  166.                 BEGIN;
  167.  
  168.                   t_str := subword(@t_str, 3, 1);
  169.  
  170.                   i := POS(t_str[1], user_class_string);
  171.  
  172.                   {$IFDEF help_bug}
  173.                     WRITELN('USER=', LENGTH(t_str), '=', t_str, '=', i);
  174.                     DELAY(1000);
  175.                   {$ENDIF}
  176.  
  177.                   IF i > 0 THEN
  178.                     DEC(i);
  179.                   IF i <= ORD(active_tcb^.uid_data.user_class) THEN
  180.                     found := TRUE;
  181.  
  182.                 END;
  183.           END;
  184.       END;
  185.  
  186.     IF (NOT found) OR EOF(help_f) THEN
  187.       BEGIN;
  188.         CLOSE(help_f);
  189.         send_message(message_help_nf);
  190.         active_tcb^.error_sw := TRUE;
  191.         EXIT;
  192.       END;
  193.  
  194.     WHILE NOT EOF(help_f) DO
  195.       BEGIN;
  196.         READLN(help_f, t_str);
  197.         IF (LENGTH(t_str) > 0) AND (t_str[1] = ':') THEN
  198.           BEGIN;
  199.             CLOSE(help_f);
  200.             EXIT;
  201.           END;
  202.         send_tnc_data_str(t_str + cr);
  203.       END;
  204.  
  205.     CLOSE(help_f);
  206.  
  207.   END;
  208.  
  209. END.
  210.